C
      SUBROUTINE CONMAT(NTAP1,NTAP2,NREC,NEL,M,N,IX,IY,IH)
C
C     THIS PROGRAM FINDS CONTINGENCY MATRICES INDICATING AGREEMENTS
C     BETWEEN TWO MAPS IN TERMS OF CLASS LABELS AND THE BOUNDARY TYPES.
C     IH(*,*,I,J) REFERS TO LOCATIONS WITH CLASS I IN MAP 1 AND CLASS J
C     IN MAP 2.  LEFT HALF OF IH GIVES A COUNT OF AGREEMENTS AND THE
C     RIGHT HALF, DISAGREEMENTS.
C     ROWS OF IH(*,*,I,J) CORRESPOND TO MAP 1, AND COLUMNS TO MAP2.
C     ROW NUMBERS 1, 2, 3, 4 INDICATE NO BOUNDARY, CHANGE IN VERTICAL
C     DIRECTION, CHANGE IN HORIZONTAL DIRECTION, CHANGE IN BOTH DIREC-
C     TIONS, RESPECTIVELY, IN MAP 1.  SIMILARLY COLUMN NUMBERS INDICATE
C     TYPES OF TRANSITIONS IN MAP2.
C     THE PROGRAM HANDLES THE PRESENT ROW OF THE MAP 1 IN IX(*,I2)
C     AND THE IMMEDIATELY PREVIOUS ROW IN IX(*,I1).  THE ROWS OF MAP 2
C     ARE HANDLED SIMILARLY IN IY.
C
      DIMENSION IH(4,8,M,N)
      LOGICAL*1 IX(NEL,2), IY(NEL,2)
C
C     INITIALIZE THE ARRAYS IX AND IY.  THE "PREVIOUS" ROW TO ROW 1 IS
C     CONSIDERED IDENTICAL TO ROW 1.
      CALL SARN (NTAP1, IX, NEL)
      CALL SARN (NTAP2, IY, NEL)
      DO 10 J=1,NEL
      IX(J,2)=IX(J,1)
   10 IY(J,2)=IY(J,1)
      DO 20 I=1,4
      DO 20 J=1,8
      DO 20 K=1,M
      DO 20 L=1,N
   20 IH(I,J,K,L) = 0
      I1=1
      I2=2
C
C     LOOP ON RECORDS.
      DO 40 I=1,NREC
C
C     LOOP ON PIXELS.
      DO 30 J=1,NEL
      JP=MAX0(1,J-1)
C
C     NONPOSITIVE VALUES OF MAP LABELS ARE NOT OF INTEREST.
      IF (IX(J,I2).EQ.0.OR.IY(J,I2).EQ.0) GO TO 30
C
C     FIND ROW AND COLUMN NUMBERS IN IH TO BE INCREMENTED.
C
C     CHECK THE NATURE OF THE BOUNDARIES IN BOTH THE MAPS.
      K=IX(J,I2)
      L=IY(J,I2)
      II=1+INTLOG(IX(J,I2).NE.IX(J,I1))+2*INTLOG(IX(J,I2).NE.IX(JP,I2))
      JJ=1+INTLOG(IY(J,I2).NE.IY(J,I1))+2*INTLOG(IY(J,I2).NE.IY(JP,I2))
C
C     FIND THE INCREMENTS.
C     INC = NUMBER OF AGREEMENTS; INC3 = NUMBER OF DISAGREEMENTS.
      INC=INTLOG(IX(J,I2).EQ.IY(J,I2))
     .  + INTLOG(IX(J,I1).EQ.IY(J,I1)) + INTLOG(IX(JP,I2).EQ.IY(JP,I2))
      INC3=3-INC
      IH(II,JJ,K,L)=IH(II,JJ,K,L) + INC
      IH(II,JJ+4,K,L)=IH(II,JJ+4,K,L)+INC3
   30 CONTINUE
C
C     EXCHANGE I1 AND I2
      IW=I1
      I1=I2
      I2=IW
C
C     READ NEXT RECORDS INTO IX(*,I2),IY(*,I2)
      IF (I.EQ.NREC) GO TO 40
      CALL SARN (NTAP1, IX(1,I2), NEL)
      CALL SARN (NTAP2, IY(1,I2), NEL)
   40 CONTINUE
C
C     PRINT THE MATRICES SHOWING TRANSITION COUNTS
      CALL CONMXP (IH, NREC, NEL, M, N)
      RETURN
      END
C
      SUBROUTINE CONMXP (IH, NREC, NEL, M, N)
C
C     PRINT MATRICES SHOWING NUMBERS OF AGREEMENTS AND DISAGREEMENTS
C     OF TRANSITIONS FOR EACH PAIR OF CLASSES.
C     INPUTS:  TITLE IS AN 80 CHARACTER(MAX) TITLE TO BE PRINTED ON TOP
C              OF EACH PAGE OF OUTPUT.  NREC, NEL, M, N ARE NUMBER OF
C              RECORDS, NUMBER OF PIXELS/RECORD, NUMBER OF CLASSES IN
C              MAP 1 AND NUMBER OF CLASSES IN MAP 2, RESPECTIVELY.
C
      DIMENSION IH(4,8,M,N), IH1(4,4), IH2(20,20), INV1(20), INV2(20)
      LOGICAL*1 TITLE(80)
C
      READ(5,100) TITLE
      L=0
      DO 10 I=1,M
      DO 10 J=1,N
      IF(MOD(L,4).NE.0)GO TO 15
      WRITE(6,110)TITLE
      WRITE(6,400)NREC,NEL
15    CONTINUE
      L=L+1
      WRITE(6,500)I,J
      DO 20 K=1,4
20    WRITE(6,300)(IH(K,KK,I,J),KK=1,8)
10    CONTINUE
C
C     FIND AND PRINT MATRICES SHOWING COUNTS OF EACH TYPE OF TRANSITION
C     FOR EACH PAIR  OF CLASSES.  THESE SHOW, FOR ALL JOINT OCCURRENCES
C     OF CLASSES (I,J) IN MAPS 1,2, THE NUMBERS OF JOINT OCCURRENCES
C     OF EACH TYPE OF TRANSITION IN THE TWO MAPS.
      DO 30 I=1,M
      DO 30 J=1,N
      DO 30 K=1,4
      DO 30 L=1,4
30    IH(K,L,I,J)=(IH(K,L,I,J)+ IH(K,L+4,I,J))/3
C
      L=0
      DO 40 I=1,M
      DO 40 J=1,N
      IF(MOD(L,4).NE.0)GO TO 45
      WRITE(6,110)TITLE
      WRITE(6,410)NREC,NEL
45    CONTINUE
      L=L+1
      WRITE(6,500)I,J
      DO 50 K=1,4
50    WRITE(6,310)(IH(K,KK,I,J),KK=1,4)
40    CONTINUE
C
C     FIND IH1, THE MATRIX OF COUNTS OF TRANSITION TYPES (WITHOUT REGARD
C     TO CLASS LABELS) AND IH2, THE MATRIX OF JOINT OCCURRENCES OF CLASS
C     LABELS (WITH NO REGARD TO TRANSITION TYPES).
      DO 55 I=1,4
      DO 55 J=1,4
55    IH1(I,J) = 0
      DO 56 I=1,M
      DO 56 J=1,N
56    IH2(I,J) = 0
      DO 60 I=1,M
      DO 60 J=1,N
      DO 60 K=1,4
      DO 60 L=1,4
      IH1(K,L)=IH1(K,L)+IH(K,L,I,J)
60    IH2(I,J)=IH2(I,J)+IH(K,L,I,J)
C
C     PRINT IH1 AND THE CORRESPONDING SIMILARITY MEASURE.
      WRITE(6,110)TITLE
      WRITE(6,420) NREC,NEL
      DO 70 K=1,4
70    WRITE(6,310)(IH1(K,L),L=1,4)
      ITR=0
      ISUM=0
      DO 90 I=1,4
      ITR=ITR+IH1(I,I)
      DO 90 J=1,4
90    ISUM=ISUM+IH1(I,J)
      PCT=ITR*100./ISUM
      WRITE(6,600)ITR,ISUM,PCT
      WRITE(6,430)
C
C     PRINT IH2 AND THE CORRESPONDING SIMILARITY MEASURE.
      DO 80 I=1,M
80    WRITE(6,310)(IH2(I,J),J=1,N)
      ITR=0
      ISUM=0
      DO 95 I=1,M
      IF(I.LE.N)ITR=ITR+IH2(I,I)
      DO 95 J=1,N
95    ISUM=IH2(I,J)+ISUM
      PCT=ITR*100./ISUM
      WRITE(6,700)ITR,ISUM,PCT
C
      DO 81 I=1,M
81    INV1(I) = 0
      DO 82 J=1,N
82    INV2(J) = 0
      DO 85 I=1,M
      DO 85 J=1,N
      INV1(I)=INV1(I)+IH2(I,J)
85    INV2(J)=INV2(J)+IH2(I,J)
      WRITE(6,800)(INV1(I),I=1,M)
      WRITE(6,810)(INV2(J),J=1,N)
      RETURN
C
100   FORMAT(80A1)
110   FORMAT('1'20X80A1)
300   FORMAT('0'4I8,'  ! '4I8)
310   FORMAT('0'15I8)
400   FORMAT(/' MATRICES SHOWING COUNTS OF AGREEMENTS AND DISAGREEMENTS
     .FOR EACH TYPE OF TRANSITION'/' MAP SIZE='I5,' BY'I5,'.')
410   FORMAT(/' MATRICES SHOWING COUNTS OF EACH TYPE OF TRANSITION'/
     .     /' MAP SIZE='I5,' BY'I5,'.')
420   FORMAT(/' MATRIX SHOWING TOTALS OF EACH TYPE OF TRANSITION'/
     .     ' MAP SIZE='I5,' BY'I5,'.')
430   FORMAT(//' CONTINGENCY TABLE')
500   FORMAT(//' CLASS NUMBER IN MAP 1='I2,' CLASS NUMBER IN MAP 2='I2)
600   FORMAT(' TRANSITION SIMILARITIES='I7,'; TOTAL='I7,'; PERCENTAGE='
     .     F7.2)
700   FORMAT(' NUMBER OF POINT BY POINT SIMILARITIES='I7,' TOTAL='I7,
     .     ' PERCENTAGE='F7.2)
800   FORMAT(/' INVENTORY OF MAP1:'/(1X15I8))
810   FORMAT(/' INVENTORY OF MAP2:'/(1X15I8))
      END
C
      FUNCTION INTLOG(L)
C
C     CONVERT A LOGICAL VARIABLE TO INTEGER
C       IF  TRUE, FUNCTION RETURNS 1
C       IF FALSE, FUNCTION RETURNS 0
C
      LOGICAL L
C
      INTLOG=0
      IF(L)INTLOG=1
      RETURN
      END
C
      SUBROUTINE DARN(IDEV,IREC,X,N)
C
C     THIS SUBROUTINE READS N BYTES FROM DIRECT ACCESS DEVICE IDEV
C     STARTING AT RECORD IX INTO ARRAY X
C
      LOGICAL*1 X(N)
      READ(IDEV'IREC)X
      RETURN
C
      ENTRY DAWN(IDEV,IREC,X,N)
C
C  THIS ENTRY WRITES N BYTES OF ARRAY X ONTO RECORD IX OF DIRECT ACCESS
C  DEVICE IDEV
      WRITE(IDEV'IREC)X
      RETURN
C
      ENTRY SARN(NTAPI,X,N)
C
C  THIS ENTRY READS N BYTES FROM SEQUENTIAL ACCESS UNIT NTAPI INTO
C  ARRAY X
      READ(NTAPI)X
      RETURN
C
      ENTRY SAWN(NTAPO,X,N)
C
C  THIS ENTRY WRITES N BYTES OF ARRAY X ONTO SEQUENTIAL ACCESS
C  UNIT NTAPI
      WRITE(NTAPO)X
      RETURN
      END
